﻿ 


Type xywh_dmsoft Extends dmsoft
   
End Type







/'
' 绑定窗口 [之前绑定过则自动解绑]
Function xywh_dmobj.Bind(hWindow As HANDLE,Display As ZString Ptr,Mouse As ZString Ptr,Keypad As ZString Ptr,sPublic As ZString Ptr,Mode As Integer=0,Mask As Integer=0) As Integer
   If hWindow Then
      UnBind()
      ' 处理掩码动作
      If Mask And 1 Then      ' [1=绑定前激活窗口]
         dmobj->lpvtbl->SetWindowState(dmobj,Cast(Integer,hWindow),12,@nRet)
      EndIf
      ' 绑定窗口
      Dim dStr As Any Ptr = ToBStr(Display)
      Dim mStr As Any Ptr = ToBStr(Mouse)
      Dim kStr As Any Ptr = ToBStr(Keypad)
      Dim pStr As Any Ptr = ToBStr(sPublic)
      dmobj->lpvtbl->BindWindowEx(dmobj,Cast(Integer,hWindow),dStr,mStr,kStr,pStr,Mode,@nRet)
      SysFreeString(dStr)
      SysFreeString(mStr)
      SysFreeString(kStr)
      SysFreeString(pStr)
      hWnd = hWindow
      ReSize()
      Return nRet
   EndIf
End Function

Function xywh_dmobj.LoadDict(Index As Integer,DictFile As ZString Ptr,DictSize As Integer=0) As Integer
   If DictSize > 0 Then
      dmobj->lpvtbl->SetDictMem(dmobj,Index,Cast(Integer,DictFile),DictSize,@nRet)
   Else
      Dim dStr As Any Ptr = ToBStr(DictFile)
      dmobj->lpvtbl->SetDict(dmobj,Index,dStr,@nRet)
      SysFreeString(dStr)
   EndIf
   If nRet Then
      Return -1
   EndIf
End Function

' 把一些系统字添加到指定字库中 [优化]
Sub xywh_dmobj.AddDict(Index As Integer,Words As ZString Ptr,sFont As ZString Ptr=StrPtr("宋体"),nSize As Integer=9,nFlag As Integer=0)
   ' 获取字库信息
   Dim sStr As Any Ptr = ToBStr(Words)
   Dim fStr As Any Ptr = ToBStr(sFont)
   dmobj->lpvtbl->GetDictInfo(dmobj,sStr,fStr,nSize,nFlag,@sRet)
   SysFreeString(sStr)
   SysFreeString(fStr)
   ' 处理后添加到字库 [fStr用于获取每个字库元素，sStr用于转换为BSTR并添加到字库]
   Dim zStr As UByte Ptr = UnicodeToAsci(sRet,0)
   If zStr Then
      Dim i As Integer
      fStr = zStr
      For i = 0 To StrLen(zStr)-1
         If zStr[i] = 124 Then
            ' 找到分隔符后截断，添加到字库中
            zStr[i] = 0
            sStr = ToBStr(fStr)
            dmobj->lpvtbl->AddDict(dmobj,Index,sStr,@nRet)
            SysFreeString(sStr)
            fStr = zStr + i + 1
         EndIf
      Next
      ' 最后补充一次操作，释放内存
      sStr = ToBStr(fStr)
      dmobj->lpvtbl->AddDict(dmobj,Index,sStr,@nRet)
      SysFreeString(sStr)
      DeAllocate(zStr)
   EndIf
   /' 性能原因代码作废 [新代码性能提升一倍]
   Dim sStr As Any Ptr
   Dim fStr As Any Ptr = ToBStr(sFont)
   For i As Integer = 0 To StrLen(Words)-1
      If Cast(UByte Ptr,Words)[i] < 128 Then
         sStr = ToBStr(Chr(Cast(UByte Ptr,Words)[i]))
      Else
         i += 1
         sStr = ToBStr(Chr(Cast(UByte Ptr,Words)[i],Cast(UByte Ptr,Words)[i+1]))
      EndIf
      dmobj->lpvtbl->GetDictInfo(dmobj,sStr,fStr,nSize,nFlag,@sRet)
      dmobj->lpvtbl->AddDict(dmobj,Index,sRet,@nRet)
      SysFreeString(sStr)
   Next
   SysFreeString(fStr)
   '/
End Sub

' 根据系统字体信息创建一个字库，比AddDict要快 [验证中...]
Function xywh_dmobj.NewDict(Index As Integer,Words As ZString Ptr,sFont As ZString Ptr=StrPtr("宋体"),nSize As Integer=9,nFlag As Integer=0) As Integer
   ' 获取字库信息
   Dim sStr As Any Ptr = ToBStr(Words)
   Dim fStr As Any Ptr = ToBStr(sFont)
   dmobj->lpvtbl->GetDictInfo(dmobj,sStr,fStr,nSize,nFlag,@sRet)
   SysFreeString(sStr)
   SysFreeString(fStr)
   ' 处理后添加到字库
   Dim i As Integer
   For i = 0 To wcsLen(sRet)-1
      If sRet[i] = 124 Then
         sRet[i] = 13
      EndIf
   Next
   'Return LoadDict(Index,sRet,wcsLen(sRet))
   Return -1
End Function



' 找字 [字库ID(传-1用系统字库)、范围(传NULL为全屏)、sWord(要找的字)、sColor(颜色描述)] [成功返回找到第几组字，失败返回0]
Function xywh_dmobj.FindWord(pRect As RECT Ptr,sWord As ZString Ptr,sColor As ZString Ptr,Index As Integer=0,Sim As Double=1.0,sFont As ZString Ptr=StrPtr("宋体"),nSize As Integer=9,nFlag As Integer=0) As Integer
   Dim As VARIANT px,py
   Dim sStr As Any Ptr = ToBStr(sWord)
   Dim cStr As Any Ptr = ToBStr(sColor)
   If Index >= 0 Then
      If Index <> Dict Then
         UseDict(Index)
      EndIf
      If pRect Then
         dmobj->lpvtbl->FindStrFast(dmobj,pRect->Left,pRect->top,pRect->Right,pRect->bottom,sStr,cStr,Sim,@px,@py,@nRet)
      Else
         dmobj->lpvtbl->FindStrFast(dmobj,0,0,nWidth,nHeight,sStr,cStr,Sim,@px,@py,@nRet)
      EndIf
   Else
      Dim fStr As Any Ptr = ToBStr(sFont)
      If pRect Then
         dmobj->lpvtbl->FindStrWithFont(dmobj,pRect->Left,pRect->top,pRect->Right,pRect->bottom,sStr,cStr,Sim,fStr,nSize,nFlag,@px,@py,@nRet)
      Else
         dmobj->lpvtbl->FindStrWithFont(dmobj,0,0,nWidth,nHeight,sStr,cStr,Sim,fStr,nSize,nFlag,@px,@py,@nRet)
      EndIf
      SysFreeString(fStr)
   EndIf
   CX = px.lVal
   CY = py.lVal
   SysFreeString(sStr)
   SysFreeString(cStr)
   Return nRet + 1
End Function

' 找字点击 [字库ID(传-1用系统字库)、范围(传NULL为全屏)、sWord(要找的字)、sColor(颜色描述)、mx(横坐标偏移)、my(纵坐标偏移)]
Function xywh_dmobj.ClickWord(pRect As RECT Ptr,sWord As ZString Ptr,sColor As ZString Ptr,mx As Integer=0,my As Integer=0,Index As Integer=0,Sim As Double=1.0,sFont As ZString Ptr=StrPtr("宋体"),nSize As Integer=9,nFlag As Integer=0) As Integer
   Dim RetInt As Integer = FindWord(pRect,sWord,sColor,Index,Sim,sFont,nSize,nFlag)
   If RetInt Then
      ClickPoint(CX+mx,CY+my)
      Return RetInt
   EndIf
End Function

Function xywh_dmobj.Ocr(pRect As RECT Ptr,sColor As ZString Ptr,Index As Integer=0,Sim As Double=1.0) As ZString Ptr
   If Index <> Dict Then
      UseDict(Index)
   EndIf
   Dim cStr As Any Ptr = ToBStr(sColor)
   If pRect Then
      dmobj->lpvtbl->Ocr(dmobj,pRect->left,pRect->top,pRect->right,pRect->bottom,cStr,Sim,@sRet)
   Else
      dmobj->lpvtbl->Ocr(dmobj,0,0,nWidth,nHeight,cStr,Sim,@sRet)
   EndIf
   SysFreeString(cStr)
   Return W2A(sRet)
End Function

' 找图  [成功返回找到第几张图片，失败返回0]
Function xywh_dmobj.FindImage(pRect As RECT Ptr,sFile As ZString Ptr,sColor As ZString Ptr=StrPtr("000000"),Sim As Double=1.0,Mode As Integer=0) As Integer
   Dim As VARIANT px,py
   Dim fStr As Any Ptr = ToBStr(sFile)
   Dim cStr As Any Ptr = ToBStr(sColor)
   If pRect Then
      dmobj->lpvtbl->FindPic(dmobj,pRect->Left,pRect->top,pRect->Right,pRect->bottom,fStr,cStr,Sim,Mode,@px,@py,@nRet)
   Else
      dmobj->lpvtbl->FindPic(dmobj,0,0,nWidth,nHeight,fStr,cStr,Sim,Mode,@px,@py,@nRet)
   EndIf
   CX = px.lVal
   CY = py.lVal
   SysFreeString(fStr)
   SysFreeString(cStr)
   Return nRet + 1
End Function

' 找图点击
Function xywh_dmobj.ClickImage(pRect As RECT Ptr,sFile As ZString Ptr,mx As Integer=0,my As Integer=0,sColor As ZString Ptr=StrPtr("000000"),Sim As Double=1.0,Mode As Integer=0) As Integer
   Dim RetInt As Integer = FindImage(pRect,sFile,sColor,Sim,Mode)
   If RetInt Then
      ClickPoint(CX+mx,CY+my)
      Return RetInt
   EndIf
End Function

' 找色
Function xywh_dmobj.FindColor(PRECT As Rect Ptr,sColor As ZString Ptr,Sim As Double=1.0,nDir As Integer=0) As Integer
   Dim As VARIANT px,py
   Dim cStr As Any Ptr = ToBStr(sColor)
   If pRect Then
      dmobj->lpvtbl->FindColor(dmobj,PRECT->Left,PRECT->top,PRECT->Right,PRECT->bottom,cStr,Sim,nDir,@px,@py,@nRet)
   Else
      dmobj->lpvtbl->FindColor(dmobj,0,0,nWidth,nHeight,cStr,Sim,nDir,@px,@py,@nRet)
   EndIf
   CX = px.lVal
   CY = py.lVal
   SysFreeString(cStr)
   Return nRet
End Function

Function xywh_dmobj.ClickColor(pRect As RECT Ptr,sColor As ZString Ptr,mx As Integer=0,my As Integer=0,Sim As Double=1.0,nDir As Integer=0) As Integer
   Dim RetInt As Integer = FindColor(pRect,sColor,Sim,nDir)
   If RetInt Then
      ClickPoint(CX+mx,CY+my)
      Return RetInt
   EndIf
End Function

Sub xywh_dmobj.MouseClick(nBtn As Integer=0)
   Select Case nBtn
      Case 1
         dmobj->lpvtbl->RightClick(dmobj,@nRet)
      Case 2
         dmobj->lpvtbl->MiddleClick(dmobj,@nRet)
      Case Else
         dmobj->lpvtbl->LeftClick(dmobj,@nRet)
   End Select
End Sub

Sub xywh_dmobj.MouseDown(nBtn As Integer=0)
   If nBtn = 1 Then
      dmobj->lpvtbl->RightDown(dmobj,@nRet)
   Else
      dmobj->lpvtbl->LeftDown(dmobj,@nRet)
   EndIf
End Sub

Sub xywh_dmobj.MouseUp(nBtn As Integer=0)
   If nBtn = 1 Then
      dmobj->lpvtbl->RightUp(dmobj,@nRet)
   Else
      dmobj->lpvtbl->LeftUp(dmobj,@nRet)
   EndIf
End Sub

Sub xywh_dmobj.ClickPoint(mx As Integer,my As Integer,nBtn As Integer=0)
   MoveTo(mx,my)
   MouseClick(nBtn)
End Sub
'/











/' -------------------------- 补充功能 -------------------------- '/
Dim Shared xywh_dm_temprect As RECT
Function MakeRect(x1 As Integer,y1 As Integer,x2 As Integer,y2 As Integer) As RECT Ptr
   xywh_dm_temprect.left   = x1
   xywh_dm_temprect.top   = y1
   xywh_dm_temprect.right   = x2
   xywh_dm_temprect.bottom   = y2
   Return @xywh_dm_temprect
End Function